﻿/// /////////////////////////////////////////////
// 单元名 : CompileConfigForm
// 作者 : Hawk
// 单元描述 : 编译服务器 UI
// 日期 : 2023-09-15
/// /////////////////////////////////////////////

{$IFDEF FPC}
{$H+}
{$MODE DELPHI}
{$ENDIF}
unit CompileConfigForm;

interface

uses
{$IFnDEF FPC}
  Windows,
{$ELSE}
  LCLIntf, LCLType, LMessages,
{$ENDIF}
  Messages, SysUtils, Classes, Graphics, Controls, Forms, MsgBaseForm, ComCtrls, StdCtrls,
  unitCommonDataStruct, unitMsgObj, Buttons, CheckLst, unitClientBuffer, unitCompilerCommon;

type
  TfrmCompilerConfig = class(TfrmMsgBase)
    PageControl1: TPageControl;
    TabSheet2: TTabSheet;
    gbCompilePrompt: TGroupBox;
    mCompilePrompt: TMemo;
    btnInstanceComp: TBitBtn;
    lvCompPrjs: TListView;
    procedure btnInstanceCompClick(Sender: TObject);
  private
    { Private declarations }
    FCompilePromptBuf: AnsiString;
    procedure ProcCompilePrompt(m: TMsg);
    procedure ProcCompileItemList(m: TMsg);
    procedure ProcCompileProgress(m: TMsg);
  protected
    procedure DoProcMsg(msg: TMsg); override;
  public
    { Public declarations }
    procedure FuncStart; override;
    procedure FuncStop; override;
  end;

implementation

uses unitObjPool, formBaseDialog, unitClassIDDef, unitErrCodeDef, unitMisc, unitUniqueDataCommon;

const
  ID_COMPILESCRIPT: TID_OBJ = (IDDetail: (ObjType: 5; SubType: $C5;
    SubID: (IDBuf: ($71, $08, $FE, $82, $78, $4A, $5B, $95, $08, $7E, $5D, $AA, $DA, $CA))));
  ID_COMPILESCRIPTQUEUE: TID_OBJ = (IDDetail: (ObjType: 5; SubType: $C5;
    SubID: (IDBuf: ($71, $08, $FE, $82, $78, $4A, $5B, $95, $08, $7E, $5D, $AA, $DA, $CB))));

{$IFnDEF FPC}
  {$R *.dfm}
{$ELSE}
  {$R *.lfm}
{$ENDIF}
  { TfrmCompilerConfig }

procedure TfrmCompilerConfig.btnInstanceCompClick(Sender: TObject);
var
  m: TMsg;
  i: Integer;
begin
  m := GetMsg;
  m.TargetObjID := ROOTID_COMPILERMODULE;
  m.MsgID := MESID_COMPILER_EXEC;
  for i := 0 to lvCompPrjs.Items.Count - 1 do
    if lvCompPrjs.Items[i].Checked then
      m.AddIDObj(EMPTY_ID_OBJ, lvCompPrjs.Items[i].Caption, nil, True);
  if m.Count > 0 then
    SendMsg(m)
  else
    ShowErrorMsg('请选择需要编译的项目', []);
end;

procedure TfrmCompilerConfig.DoProcMsg(msg: TMsg);
begin
  case msg.MsgID of
    MESID_COMPILER_PROMPT:
      ProcCompilePrompt(msg);
    MESID_COMPILER_ITEMLIST:
      ProcCompileItemList(msg);
    MESID_COMPILER_PROGRESS:
      ProcCompileProgress(msg);
  else
    inherited;
  end;
end;

procedure TfrmCompilerConfig.FuncStart;
begin
  inherited;
  SendMsg(ROOTID_COMPILERMODULE, MESID_COMPILER_FETCHITEMS, EMPTY_ID_OBJ);
end;

procedure TfrmCompilerConfig.FuncStop;
begin
  inherited;
end;

procedure TfrmCompilerConfig.ProcCompilePrompt(m: TMsg);
var
  cp: TCompilerPrompt;

  procedure OutputToUI;
  var
    i: Longword;
  begin
    i := 0;
    while i < cp.PromptSize do
    begin
      case cp.Prompt[i] of
        #10:
          begin
            mCompilePrompt.Lines.Add(FCompilePromptBuf);
            FCompilePromptBuf := '';
          end;
        #13:
          ;
      else
        FCompilePromptBuf := FCompilePromptBuf + cp.Prompt[i];
      end;
      Inc(i);
    end;
  end;

begin
  while m.Count > 0 do
  begin
    cp := m.Param(TCompilerPrompt);
    if cp <> nil then
    begin
      OutputToUI;
      ObjPool.ReturnObj(cp, Self);
    end
    else
      Break;
  end;
end;

procedure TfrmCompilerConfig.ProcCompileItemList(m: TMsg);
var
  so: TStringObj;
begin
  lvCompPrjs.Clear;
  while m.Count > 0 do
  begin
    so := m.Param(TStringObj);
    if so <> nil then
    begin
      with lvCompPrjs.Items.Add do
      begin
        Caption := so.Str;
        SubItems.Add(so.Caption);
      end;
      ObjPool.ReturnObj(so, Self);
    end
    else
      Break
  end;
end;

procedure TfrmCompilerConfig.ProcCompileProgress(m: TMsg);
begin
  Case (m.data) of
    I_COMPILEPROGRESS_STARTED:
      begin
        mCompilePrompt.Clear;
        FCompilePromptBuf := '';
      end;
    I_COMPILEPROGRESS_STOPED:
      ;
  End;
end;

initialization

RegFuncClass(HOSTID_ROOT, '系统编译', '提供本系统编译管理界面', TfrmCompilerConfig);

end.
